subroutine ccsdt_sym_aab_dg(ie, t1aa, t2aa, t2ab,  t2aa2, t2ab2,  & 
                    iijkaaa, iijkaab, iabijaa, iabijab, &
                    tmp1, tmp2, tmp3, tmp4, tmp5, tmpe, &
                    iabciaa, iabciab, & 
                    icoreg, e4t, e5st, icore)
use mod_iop
use mod_orbit
use mod_size
use mod_symm
use mod_t
implicit none 
integer prec2, isd2, igpu2, totgpu2
common/precsoc/prec2, isd2, igpu2, totgpu2
real*8, intent(in) :: e4t, e5st
real*8, intent(in),device :: ie(*), t1aa(*),  t2aa(*), t2ab(*)
real*8, intent(in),device :: t2aa2(*), t2ab2(*), icoreg(*) 
real*8, intent(in),device :: iijkaaa(*), iijkaab(*)
real*8, intent(in),device :: iabijaa(*), iabijab(*)
real*8, intent(in),device :: iabciaa(*), iabciab(*)
real*8, intent(in),device :: tmp1(*), tmp2(*), tmp3(*), tmp4(*), tmp5(*), tmpe(*)
!
real*8, intent(in) :: icore(*)
integer i0, i1, i2, i3, nsize
integer irrepi, numi
integer ioffvvvoaa(noa,8), ioffvvvoab(noa, 8), ioffvvvoba(noa, 8)
integer ioffvvoo2aa(noa, 8), ioffvvoo2ab(noa, 8), ioffvvoo2ba(noa, 8) 
integer ioffvoaa(noa, 8), ioffvobb(noa, 8)
integer ioffvoooaa(noa,noa,8,8), ioffvoooab(noa, noa, 8, 8)
integer ioffvoooba(noa,noa, 8, 8), ioffvvooaa(noa,noa,8,8)
integer ioffvvooab(noa, noa, 8, 8), ioffvvooba(noa, noa, 8, 8)
!
integer irrepki, irrepij, irrepjk, irrepabc, numj, numk
integer irrepj, irrepk, i, j, k, iofftmp
integer, external :: idsymsoc, irpdso
real*8, external :: nrm2so
igpu=0; igpu=0
i0 = 1
i1 = i0 + nvvoo
i2 = i1 + nvvoo
!
!calcioff
!for iabci--------------
call idxpqr_s(ioffvvvoaa, noa, vrta, vrta, 0, vrta, popa, 1, 1)
call idxpqr_s(ioffvvvoab, noa, vrta, vrtb, 1, vrta, popb, 1, 1)
!for t2aa2--------------
call idxpqr_s(ioffvvoo2aa, noa, vrta, vrta, 0, popa, popa, 1, 1)
call idxpqr_s(ioffvvoo2ab, noa, vrta, vrtb, 1, popa, popb, 1, 1)
!for t1
call idxpqr_s(ioffvoaa, noa, zorb, zorb, 1, vrta, popa, 1, 1)
call idxpqr_s(ioffvobb, noa, zorb, zorb, 1, vrtb, popb, 1, 1)
!for t2aa and iabij
call idxpq_rs(ioffvvooaa, noa, noa, vrta, vrta, 1, popa, popa, 1, 1)
call idxpq_rs(ioffvvooab, noa, noa, vrta, vrtb, 1, popa, popb, 1, 1)
!for iijka
call idxpq_rs(ioffvoooaa, noa, noa, popa, vrta, 1, popa, popa, 1, 1)
call idxpq_rs(ioffvoooab, noa, noa, popa, vrtb, 1, popa, popb, 1, 1)
!write(6,*)'ioffvooo', ioffvooo(2,3, 1,1)
!
!=======get t1
!
call getuhf(icore, 1, 'T1AA____')
nsize = irpdso(1, vrta, vrta, 1) 
call myicopy_g(icore, t1aa, nsize)
!
!call getuhf(t1aa, 1, 'T1AA____')
!call getuhf(t1bb, 1, 'T1BB____')
!
!=======get t2
!
call getuhf(icore(i0), 1, 'T2AA____')
call iexpso(icore(i0), icore(i1), vrta, vrta, 0, 0, popa, popa, 0, 1, 1)
call sstgenso(icore(i1), icore(i0), nsize, nvvaa, zorb,  popa, popa, & 
             icore, 1, '1324')
nsize = idsymsoc(1, vrta, vrta, 0, popa, popa, 1)
call myicopy_g(icore(i0), t2aa2, nsize)
!call sstgenso(icore(i1), t2aa2, nsize, nvvaa, zorb,  popa, popa, & 
!             icore, 1, '1324')
call iexpso(icore(i1), icore(i0), vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
nsize = idsymsoc(1, vrta, vrta, 1, popa, popa, 1)
call myicopy_g(icore(i0), t2aa, nsize)
!call iexpso(icore(i1), t2aa, vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
!
call getuhf(icore(i0), 1, 'T2AB____')
nsize = idsymsoc(1, vrta, vrtb, 1, popa, popb, 1) 
call myicopy_g(icore(i0), t2ab, nsize)
!call getuhf(t2ab, 1, 'T2AB____')
call sstgenso(icore(i0), icore(i1), nsize, nvvab, zorb, popa, popb, & 
              icore, 1, '1324')
call myicopy_g(icore(i1), t2ab2, nsize)
!call sstgenso(icore(i0), t2ab2, nsize, nvvab, zorb, popa, popb, & 
!              icore, 1, '1324')
 call isymtrso(icore(i0), icore(i1), vrta, vrtb, 1, 1, popa, popb, 1, 0, 1) 
 call isymtrso(icore(i1), icore(i0), vrtb, vrta, 1, 0, popa, popb, 1, 1, 1) 
call sstgenso(icore(i0), icore(i1), nsize, nvvab, zorb, popb, popa, & 
              icore, 1, '1324')
if(ldebug) then
igpu=1 
nsize = idsymsoc(1, vrta, vrta, 1, popa, popa, 1)
write(6,*)'norm of t2aa', nrm2so(nsize, t2aa, 1)
nsize = idsymsoc(1, vrta, vrta, 0, popa, popa, 1)
write(6,*)'norm of t2aa2', nrm2so(nsize, t2aa2, 1)
nsize = idsymsoc(1, vrta, vrtb, 1, popa, popb, 1)
write(6,*)'norm of t2ab', nrm2so(nsize, t2ab, 1)
write(6,*)'norm of t2ab2', nrm2so(nsize, t2ab2, 1)
igpu=0 
endif
!
!=======get iabij(a<b,i<j) and transfer to iabij(a,b,i,j) 
!
call getuhf(icore(i0), 1, 'ABIJAA__')
call iexpso(icore(i0), icore(i1), vrta, vrta, 0, 0, popa, popa, 0, 1, 1)
call iexpso(icore(i1), icore(i0), vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
nsize = idsymsoc(1, vrta, vrta, 1, popa, popa, 1) 
call myicopy_g(icore(i0), iabijaa, nsize)
!call iexpso(icore(i1), iabijaa,   vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
nsize = idsymsoc(1, vrta, vrtb, 1, popa, popb, 1) 
call getuhf(icore(i0), 1, 'ABIJAB__')
call myicopy_g(icore(i0), iabijab, nsize)
!call getuhf(iabijab, 1, 'ABIJAB__')
!
!=======get iijka(i<j,k,a) and transfer to iijka(k,a,i,j)
!
call getuhf(icore(i0), 1, 'IJKAAA__')
call itranspso(icore(i0), icore(i1), popa, popa, 0, popa, vrta, 1, 1)
call iexpso(icore(i1), icore(i0), popa, vrta, 1, 0, popa, popa, 0, 1, 1)
nsize = idsymsoc(1, vrta, popa, 1, popa, popa, 1)
call myicopy_g(icore(i0), iijkaaa, nsize)
!call iexpso(icore(i1), iijkaaa, popa, vrta, 1, 0, popa, popa, 0, 1, 1)
!
call getuhf(icore(i0), 1, 'IJKAAB__')
call itranspso(icore(i0), icore(i1), popa, popb, 1, popa, vrtb, 1, 1)
nsize = idsymsoc(1, popa,vrtb, 1, popa, popb, 1)
call myicopy_g(icore(i1), iijkaab, nsize)
!call itranspso(icore(i0), iijkaab, popa, popb, 1, popa, vrtb, 1, 1)
!
if(ldebug) then
igpu = 1 
nsize = idsymsoc(1, popa, popa, 1, vrta, popa, 1) 
write(6,*)'norm of iijkaaa', nrm2so(nsize, iijkaaa, 1)
igpu = 0 
endif
! 
!=======get iabci aa, ab and ba
!
!call getuhf(iabci, 1, 'ABCIAA__')
!nsize = idsymsoc(1, vrta, vrta, 0, vrta, popa, 1) 
!write(6,*)'norm of iabciaa', nrm2so(nsize, iabci, 1)
do irrepi = 1, nirrep
   numi = popa(irrepi)
   do i = 1, numi
   iofftmp = ioffvvvoaa(i, irrepi)
   call getpqrso(icore, i, irrepi, 1, 'ABCIAA__')
   nsize = idsymsoc(irrepi, vrta, vrta, 0, vrta, zorb, 1) 
   call myicopy_g(icore, iabciaa(iofftmp), nsize)
   enddo
enddo
do irrepi = 1, nirrep
   numi = popb(irrepi)
   do i = 1, numi
   iofftmp = ioffvvvoab(i, irrepi)
   call getpqrso(icore, i, irrepi, 1, 'ABCIAB__')
   nsize = idsymsoc(irrepi, vrta, vrtb, 1, vrta, zorb, 1)
   call myicopy_g(icore, iabciab(iofftmp), nsize)
!   call getpqrso(iabciab(iofftmp), i, irrepi, 1, 'ABCIAB__')
   enddo
enddo
if(ldebug) then
igpu = 1 
nsize = idsymsoc(1, vrta, vrta, 0, vrta, popa, 1) 
write(6,*)'norm of iabciaa', nrm2so(nsize, iabciaa, 1)
nsize = idsymsoc(1, vrta, vrtb, 1, vrta, popb, 1) 
write(6,*)'norm of iabciab', nrm2so(nsize, iabciab, 1)
nsize = idsymsoc(1, vrtb, vrta, 1, vrtb, popa, 1) 
igpu = 0 
endif
!
igpu=1; igpu2=1
do irrepk = 1, nirrep 
do irrepj = 1, nirrep
do irrepi = 1, nirrep 
   irrepij = dirprd(irrepi, irrepj) 
   irrepjk = dirprd(irrepj, irrepk) 
   irrepki = dirprd(irrepk, irrepi) 
   irrepabc = dirprd(irrepij, irrepk)
   numi = popa(irrepi)
   numj = popa(irrepj) 
   numk = popb(irrepk) 
   if(irrepi>irrepj) cycle
   if(irrepi==irrepj) then
      do k = 1, numk 
      do j = 2, numj
      do i = 1, j-1 
      call ccsdt_calcaab_2(ie, ie(nva+noa+1), t1aa(ioffvoaa(i,irrepi)), & 
          t1aa(ioffvoaa(j,irrepj)), t1aa(ioffvobb(k,irrepk)), &
          t2aa(ioffvvooaa(i,j,irrepi,irrepj)), t2ab(ioffvvooab(i,k,irrepi,irrepk)),&
          t2ab(ioffvvooab(j,k,irrepj,irrepk)), t2ab(ioffvvooab(k,i,irrepk,irrepi)),&
          t2ab(ioffvvooab(k,j,irrepk,irrepj)), & 
          t2aa2(ioffvvoo2aa(i,irrepi)), t2aa2(ioffvvoo2aa(j,irrepj)), & 
          t2ab2(ioffvvoo2ab(k,irrepk)), t2ab2(ioffvvoo2ab(i,irrepi)), &
          t2ab2(ioffvvoo2ab(j,irrepj)), &
          iijkaaa(ioffvoooaa(i,j,irrepi,irrepj)), iijkaab(ioffvoooab(i,k,irrepi,irrepk)), &
          iijkaab(ioffvoooab(j,k,irrepj,irrepk)), iijkaab(ioffvoooab(k,i,irrepk,irrepi)), &
          iijkaab(ioffvoooab(k,j,irrepk,irrepj)), & 
          iabijaa(ioffvvooaa(i,j,irrepi,irrepj)), iabijab(ioffvvooab(j,k,irrepj,irrepk)), &
          iabijab(ioffvvooab(i,k,irrepi,irrepk)), &
          tmp1, tmp2, tmp3, tmp4, tmp5, tmpe, &
          iabciaa(ioffvvvoaa(i,irrepi)), iabciaa(ioffvvvoaa(j,irrepj)), &
          iabciab(ioffvvvoab(k,irrepk)), iabciab(ioffvvvoab(i,irrepi)), &
          iabciab(ioffvvvoab(j,irrepj)), &
           irrepi, irrepj, irrepk, i, j, k,          &
          ioffvvvoaa, ioffvvvoab, ioffvvvoab,    &
          ioffvvoo2aa, ioffvvoo2ab, ioffvvoo2ab,&
          ioffvoaa, ioffvobb,&
          ioffvoooaa, ioffvoooab,&
          ioffvoooab, ioffvvooaa,&
          ioffvvooab, ioffvvooab,&
           icore, e4t, e5st,vrta, vrtb, popa, popb, 3)
!     call ccsdt_calcaab(ie, ie(nva+noa+1), t1aa, t1bb, t2aa, t2ab, t2ba,&
!                t2aa2,t2ab2, t2ba2, &
!                iijkaaa, iijkaab, iijkaba, &
!                iabijaa, iabijab,iabijba, &
!                tmp1, tmp2, tmp3, tmp4, tmp5, tmpe, &
!                iabciaa, iabciab, iabciba, &
!                 irrepi, irrepj, irrepk, i, j, k,          &
!                ioffvvvoaa, ioffvvvoab, ioffvvvoba,    &
!               ioffvvoo2aa, ioffvvoo2ab, ioffvvoo2ba,&
!               ioffvoaa, ioffvobb,&
!               ioffvoooaa, ioffvoooab,&
!               ioffvoooba, ioffvvooaa,&
!               ioffvvooab, ioffvvooba,&
!                icore, e4t, e5st,vrta, vrtb, popa, popb, 3)
      enddo
      enddo
      enddo
      elseif(irrepi<irrepj) then
        do k = 1, numk
        do j = 1, numj 
        do i = 1, numi
      call ccsdt_calcaab_2(ie, ie(nva+noa+1), t1aa(ioffvoaa(i,irrepi)), &
          t1aa(ioffvoaa(j,irrepj)), t1aa(ioffvobb(k,irrepk)), &
          t2aa(ioffvvooaa(i,j,irrepi,irrepj)),& 
          t2ab(ioffvvooab(i,k,irrepi,irrepk)),&
          t2ab(ioffvvooab(j,k,irrepj,irrepk)),&
          t2ab(ioffvvooab(k,i,irrepk,irrepi)),&
          t2ab(ioffvvooab(k,j,irrepk,irrepj)), &
          t2aa2(ioffvvoo2aa(i,irrepi)), t2aa2(ioffvvoo2aa(j,irrepj)), &
          t2ab2(ioffvvoo2ab(k,irrepk)), t2ab2(ioffvvoo2ab(i,irrepi)), &
          t2ab2(ioffvvoo2ab(j,irrepj)), &
          iijkaaa(ioffvoooaa(i,j,irrepi,irrepj)), &
          iijkaab(ioffvoooab(i,k,irrepi,irrepk)), &
          iijkaab(ioffvoooab(j,k,irrepj,irrepk)), &
          iijkaab(ioffvoooab(k,i,irrepk,irrepi)), &
          iijkaab(ioffvoooab(k,j,irrepk,irrepj)), &
          iabijaa(ioffvvooaa(i,j,irrepi,irrepj)), &
          iabijab(ioffvvooab(j,k,irrepj,irrepk)), &
          iabijab(ioffvvooab(i,k,irrepi,irrepk)), &
          tmp1, tmp2, tmp3, tmp4, tmp5, tmpe, &
          iabciaa(ioffvvvoaa(i,irrepi)), iabciaa(ioffvvvoaa(j,irrepj)), &
          iabciab(ioffvvvoab(k,irrepk)), iabciab(ioffvvvoab(i,irrepi)), &
          iabciab(ioffvvvoab(j,irrepj)), &
           irrepi, irrepj, irrepk, i, j, k,      &
          ioffvvvoaa, ioffvvvoab, ioffvvvoab,    &
          ioffvvoo2aa, ioffvvoo2ab, ioffvvoo2ab,&
          ioffvoaa, ioffvobb,&
          ioffvoooaa, ioffvoooab,&
          ioffvoooab, ioffvvooaa,&
          ioffvvooab, ioffvvooab,&
           icore, e4t, e5st,vrta, vrtb, popa, popb, 3)
       enddo
        enddo
        enddo
      endif
enddo
enddo
enddo
write(6,*)'e4t and e5st for aab', e4t, e5st 
igpu=0; igpu2=0
return
end
